FM Towns: Free Software Collection 7/FM Towns Free Software Collection 7.iso/ms_dos/renum/renum.pas

Pascal/Delphi Source File | 1993-11-30 | 5KB | 174 lines

{
        Basic renumber for Towns(DOS machine )
          386Basic ﾉ ｶｴﾅｲ(ｶﾜﾅｲﾋﾄ) ﾆ ｻｻｹﾞﾏｽ

        1993/08/07  by TMA

        Usage  A>RENUM infile.bas [line-no.]

        language: Turbo-Pascal ver 6.0
        machine : Dos machine

        1 ﾆｭｳﾘｮｸ ﾌｧｲﾙ (ASCII-saved)  ｦ ﾖﾑ
        2 1ｷﾞｮｳ ｽﾞﾂ ｾﾝﾄｳｶﾞ ｽｳｼﾞ ﾅﾗ ﾘﾅﾝﾊﾞ
        3 ｾﾝﾄｳ ﾆ ｽｳｼﾞ ｶﾞﾅｲﾄ ﾅﾝﾊﾞ ｦ ﾌｶｽﾙ
        4 temp ﾌｧｲﾙ ﾆ ｼｭﾂﾘｮｸ ｽﾙ
        5 ｾｲｼﾞｮｳ ｼｭｳﾘｮｳ ｽﾙﾄ *.org ｦ ｻｸｼﾞｮ
        6 ﾆｭｳﾘｮｸ ﾌｧｲﾙﾒｲ ｦ *.org ﾆ ﾘﾈｰﾑ
        7 temp ｦ ﾆｭｳﾘｮｸ ﾌｧｲﾙﾒｲ ﾆ  ﾘﾒｰﾑ
                                                                }
uses DOS;

type
  str255 = string[255];
const
  start_no  = 990;                        { ｷﾃｲﾁ ﾊ 1000ｷﾞｮｳ ｶﾗ }
var
  infnam  : str255;
  temp_fnam : string[50];
  inf,otf : text;
  ior     : integer;
  inrec   : str255;
  lno     : integer;
  lcnt    : integer;
  d       : Dirstr;                   { ﾌｧｲﾒｲ ﾌﾞﾝｶｲ ﾖｳ }
  n       : Namestr;
  e       : extstr;

function with_lineno(msg:str255):boolean; { ｷﾞｮｳﾊﾞﾝｺﾞｳ ｱﾘ ﾉ ﾄｷ true }
  begin
    if msg[1] in ['0'..'9']
      then with_lineno := true
      else with_lineno := false;
  end;

function startp(msg:str255):integer;    { BASIC ﾎﾝﾌﾞﾝ ｶｲｼｲﾁ ﾊﾊｯｹﾝ }
  var  p : integer;
  begin
    p := 0;
    repeat
      inc(p);
    until not(msg[p] in['0'..'9']);     { ｻｲｼｮ ﾉ not NUMERIC ﾏﾃﾞ loop }
    startp := p;
  end;

procedure renum(msg:str255);            { RENUM ﾎﾝﾀｲ }
  var p : integer;                      { ﾁｬｸﾓｸ ｲﾁ }
  begin
    lno := lno + 10;                    { ｷﾞｮｳﾊﾞﾝｺﾞｳ ++ }
    if length(msg) = 0 then begin       { ｸｳ ｷﾞｮｳ ﾊ REM ﾆ }
      writeln(otf,lno:4,' ',#$27);
      exit;
    end;

    if with_lineno(msg) then begin
       write(otf,lno:4);                { ｷﾞｮｳﾊﾞﾝｺﾞｳ ﾂｷ ﾉ ｼｮﾘ }
       writeln(otf,copy(msg,startp(msg),255));
     end
     else
       writeln(otf,lno:4,' ',msg);      { ｷﾞｮｳﾊﾞﾝｺﾞｳ ﾅｼ ｼｮﾘ }
  end;

procedure open_files;                   { OPEN files }
  begin
    assign(inf,infnam);                 { ﾆｭｳﾘｮｸ file open }
    {$i-} reset(inf); {$i+}
    ior :=ioresult;
    if ior <> 0  then begin
      writeln('IN-File open error Code:',ior);
      writeln('Program Aborted');
      HAlt;
    end;

    assign(otf,d+temp_fnam);              { TEMP   file open }
    {$i-} rewrite(otf); {$i+}
    ior :=ioresult;
    if ior <> 0  then begin
      writeln('TEMP-File open error Code:',ior);
      writeln('Program Aborted');
      close(inf);
      HAlt;
    end;
  end;

procedure make_temp;
  begin
    open_files;                         { OPEN files }
    while not eof(inf) do begin
      readln(inf,inrec);
      renum(inrec);
      inc(lcnt);
    end;
    close(inf);
    close(otf);
  end;

procedure   copy_master;                { master:rename, temp->master }
  var wfnam : string[50];
      tf    : file;                     {  temp file }
     i,j    : integer;
  begin
    wfnam := d + n + '.org';            { ｾﾞﾝｶｲ ﾉ .org ﾌｧｲﾙ ﾉ ｻｸｼﾞｮ }
    assign(tf,wfnam);
    {$i-} erase(tf); {$i+}              { error ﾊ ﾑｼ }

    assign(tf,infnam);
    {$i-} rename(tf,wfnam); {$i+}       { ﾆｭｳﾘｮｸ.bas -> *.org }
    ior :=ioresult;
    if not(ior in [0,2]) then begin     { ﾏﾆｭｱﾙ ﾆﾊ 0ｦ ｶｴｽﾄ ｱﾙｶﾞ..?? }
      writeln('1 ERROR Rename File ',infnam,'->',wfnam,' Code:',ior);
      writeln('Program Aborted');
      HAlt;
    end;

    assign(tf,temp_fnam);
    {$i-} rename(tf,infnam); {$i+}     { temp -> ﾆｭｳﾘｮｸ.bas }
    ior :=ioresult;
    if not(ior in [0,2]) then begin
      writeln('2 ERROR Rename File ',temp_fnam,'->',infnam,' Code:',ior);
      writeln('Original Source is renamed to ',wfnam);
      writeln('Exchanged file name is :',temp_fnam);
      writeln('Program Aborted');
      HAlt;
    end;
  end;

procedure get_param;
  var i,j    : integer;
  begin
    writeln('***** BASIC RENUM *******');
    if paramcount < 1 then begin
      writeln('  Usage A>RENUM infile.bas [start-lineno.]');
      writeln('  make backup file to infile.org');
      writeln('  target LINENO. is line head NUMELICS only ');
      writeln('  [start lineno] is useless option. if designation then start +10');
      halt;
    end;
    infnam := paramstr(1);
    writeln('Select filename :',infnam);

    lno := 0;
    if paramcount > 1 then begin
      val(paramstr(2),i,j);
      if j = 0 then
        lno := i;
    end;
    if lno = 0
      then lno := start_no;
    writeln('Start Lineno    :',lno+10);
    fsplit(infnam,d,n,e);               { ﾌｧｲﾙﾒｲ ﾌﾞﾝｶｲ }
    temp_fnam := d + ')TEMP(.$$$';      { ﾆｭｳﾘｮｸ ﾌｧｲﾙ ﾉ ｱﾙﾄｺﾆ ｻｸｾｲ }
  end;

{----------------- MAIN -------------------- }

begin
  get_param;                                { ｺﾏﾝﾄﾞﾗｲﾝ ｼｭﾄｸ }

  lcnt := 0;                            { ｷﾞｮｳｽｳ }
  make_temp;                            { chane to Temp file }
  copy_master;                          { master:rename, temp->master }
  writeln  ('read lines      :',lcnt);
  writeln  ('Completed');
end.